home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol218 / listper.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-11-30  |  3.4 KB  |  129 lines
  1. 100  REM LISTPER Program.
  2. 110  REM Prints a List of Persons
  3. 120  REM By:  Melvin O. Duke.  Last Updated 17 February 1986.
  4. 200  REM Screen Definitions
  5. 210  WIDTH "scrn:", 80
  6. 220  SCREEN S1,S2,S3,S4
  7. 600  REM Titles
  8. 610  TITLE$ = "List the Persons File"
  9. 620  TITLE$ = TITLE$ + " ON DISPLAY"
  10. 700  REM Terminate if not called from the Menu
  11. 710  IF DD.MENU$ <> "" THEN 770
  12. 720  COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
  13. 730  PRINT "Cannot run the"
  14. 740  PRINT TITLE$
  15. 750  PRINT "Program, unless selected from the MENU"
  16. 760  END
  17. 770  REM OK
  18. 1000  REM Produce the first screen
  19. 1010  KEY ON : CLS : KEY OFF
  20. 1020  REM Draw the outer double box
  21. 1030  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 1300
  22. 1040  REM Find the title location
  23. 1050  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  24. 1060  REM Draw the title box
  25. 1070  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 1500
  26. 1080  REM Print the title
  27. 1090  LOCATE 4,TITLE.POS : PRINT TITLE$
  28. 1100  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  29. 1230  REM Draw the Copyright box
  30. 1240  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 1300
  31. 1250  REM Print the Copyright
  32. 1260  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  33. 1270  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  34. 1280  GOTO 1700
  35. 1300  REM subroutine to print a double box
  36. 1310  COLOR P
  37. 1320  FOR I = R1 + 1 TO R2 - 1
  38. 1330   LOCATE I, C1 : PRINT CHR$(186);
  39. 1340   LOCATE I, C2 : PRINT CHR$(186);
  40. 1350  NEXT I
  41. 1360  FOR J = C1 + 1 TO C2 - 1
  42. 1370   LOCATE R1, J : PRINT CHR$(205);
  43. 1380   LOCATE R2, J : PRINT CHR$(205);
  44. 1390  NEXT J
  45. 1400   LOCATE R1, C1 : PRINT CHR$(201);
  46. 1410   LOCATE R1, C2 : PRINT CHR$(187);
  47. 1420   LOCATE R2, C1 : PRINT CHR$(200);
  48. 1430   LOCATE R2, C2 : PRINT CHR$(188);
  49. 1440  COLOR W
  50. 1450  RETURN
  51. 1500  REM subroutine to print a single box
  52. 1510  COLOR B
  53. 1520  FOR I = R1 + 1 TO R2 - 1
  54. 1530   LOCATE I, C1 : PRINT CHR$(179);
  55. 1540   LOCATE I, C2 : PRINT CHR$(179);
  56. 1550  NEXT I
  57. 1560  FOR J = C1 + 1 TO C2 - 1
  58. 1570   LOCATE R1, J : PRINT CHR$(196);
  59. 1580   LOCATE R2, J : PRINT CHR$(196);
  60. 1590  NEXT J
  61. 1600   LOCATE R1, C1 : PRINT CHR$(218);
  62. 1610   LOCATE R1, C2 : PRINT CHR$(191);
  63. 1620   LOCATE R2, C1 : PRINT CHR$(192);
  64. 1630   LOCATE R2, C2 : PRINT CHR$(217);
  65. 1640  COLOR W
  66. 1650  RETURN
  67. 1700  REM ask user to press a key to continue
  68. 1710  LOCATE 25,1
  69. 1720  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  70. 1730  K$ = INKEY$ : IF K$ = "" THEN 1730
  71. 1740  KEY ON : CLS : KEY OFF
  72. 2000  REM LISTPER Program Starts Here
  73. 2010  OPEN DD.PERS$+"persfile" AS #1 LEN = 256
  74. 2020  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  75. 2030  REM Read all records, and print the actual ones
  76. 2040  K = 0
  77. 2050  KEY ON : CLS : KEY OFF : LOCATE 21,1
  78. 2060  PRINT "Printing a List of Records in the Persons File"
  79. 2070  GOSUB 2090
  80. 2080  GOTO 2140
  81. 2090  LPRINT "       List of the Records in the Persons File  ";DATE$;"  ";TIME$
  82. 2100  LPRINT
  83. 2110  LPRINT "     REC GIVEN NAMES-SURNAME";TAB(50);"BIRTHDATE    FATHER  MOTHER
  84. 2120  LPRINT "     --- -------------------";TAB(50);"-----------  ------  ------
  85. 2130  RETURN
  86. 2140  FOR I = 1 TO MAX.PER
  87. 2150  GET #1, I
  88. 2160  LOCATE 23,1 : PRINT "Printing Record:";I
  89. 2170  REM Extract information from the file for use
  90. 2180  T1 = CVS(F1$)
  91. 2190  IF T1 < 1 THEN 2510
  92. 2200  K = K + 1
  93. 2210  T2$ = F2$
  94. 2220  FOR J = 1 TO LEN(F2$)-1
  95. 2230   IF RIGHT$(T2$,1)=" "THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
  96. 2240  NEXT J
  97. 2250  T3$ = F3$
  98. 2260  FOR J = 1 TO LEN(F3$)-1
  99. 2270   IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  100. 2280  NEXT J
  101. 2290  T4$ = F4$
  102. 2300  IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
  103. 2310  IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
  104. 2320  T5 = CVS(F5$)
  105. 2330  T6 = CVS(F6$)
  106. 2340  T7 = CVS(F7$)
  107. 2350  T8$ = F8$
  108. 2360  T9$ = F9$
  109. 2370  T10$ = F10$
  110. 2380  T11$ = F11$
  111. 2390  T12$ = F12$
  112. 2400  T13$ = F13$
  113. 2410  T14$ = F14$
  114. 2420  T15$ = F15$
  115. 2430  T16$ = F16$
  116. 2440  T17$ = F17$
  117. 2450  T18$ = F18$
  118. 2460  T19$ = F19$
  119. 2470  LPRINT USING "########";T1;
  120. 2480  LPRINT " "; LEFT$(T3$+" "+T2$,39); TAB(50); T8$;
  121. 2490  LPRINT USING "######  ######";T6, T7
  122. 2500  IF K MOD 55 = 0 THEN LPRINT FORM.FEED$;: GOSUB 2090
  123. 2510  NEXT I
  124. 2520  CLOSE #1
  125. 2530  LPRINT FORM.FEED$;
  126. 2540  KEY ON : CLS : KEY OFF : LOCATE 21,1
  127. 2550  PRINT "End of Program"
  128. 2560  RUN DD.MENU$+"menu"
  129.